home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / share / perl5 / Debian / DocBase / Utils.pm < prev   
Encoding:
Perl POD Document  |  2008-09-07  |  3.4 KB  |  161 lines
  1. # vim:cindent:ts=2:sw=2:et:fdm=marker:cms=\ #\ %s
  2. #
  3. # $Id: Utils.pm 111 2008-02-17 18:56:44Z robert $
  4. #
  5.  
  6. package Debian::DocBase::Utils;
  7.  
  8. use Exporter();
  9. use strict;
  10. use warnings;
  11. use vars qw(@ISA @EXPORT);
  12. use Carp;
  13. @ISA = qw(Exporter);
  14. @EXPORT = qw(Execute HTMLEncode HTMLEncodeDescription Inform Debug Warn Error ErrorNF 
  15.             IgnoreSignals RestoreSignals ReadMap);
  16.  
  17. use Debian::DocBase::Common;
  18.  
  19. sub HTMLEncode($) { # {{{
  20.   my $text        = shift;
  21.  
  22.   $text =~ s/&/&/g;
  23.   $text =~ s/</</g;
  24.   $text =~ s/>/>/g;
  25.   $text =~ s/"/"/g;
  26.   return $text;
  27. } # }}}
  28.  
  29. sub HTMLEncodeDescription($) { # {{{
  30.   my $text        = shift;
  31.  
  32.   $text = HTMLEncode($text);
  33.   my @lines=split(/\n/, $text);
  34.   $text = "";
  35.   my $in_pre = 0;
  36.   foreach $_  (@lines) {
  37.     s/^\s//;
  38.     if (/^\s/) {
  39.       $_ = "<pre>\n$_" unless $in_pre;
  40.       $in_pre = 1;
  41.     } else {
  42.       $_ = "$_\n<\\pre>" if $in_pre;
  43.       $in_pre = 0;
  44.     }
  45.     s/^\.\s*$/<br> <br>/;
  46.     s/(http|ftp)s?:\/([\w\/~\.%#-])+[\w\/]/<a href="$&">$&<\/a>/g;
  47.  
  48.     $text .= $_ . "\n";
  49.    }
  50.   $text .= "</pre>\n" if $in_pre;
  51.   return $text;
  52. } # }}}
  53.  
  54. sub Execute(@) { # {{{
  55.   my @args = @_;
  56.   my $sargs = join " ", @args;
  57.  
  58.   croak "Internal error: no arguments passed to Execute" if $#args < 0;
  59.  
  60.   if (-x $args[0]) {
  61.     Debug ("Executing `$sargs'");
  62.     if (system(@args) != 0) {
  63.       Warn ("error occured during execution of `$sargs'");
  64.     }
  65.   } else {
  66.     Debug ("Skipping execution of `$sargs'");
  67.   }   
  68. } # }}}
  69.  
  70.  
  71. sub Debug($) { # {{{
  72.   print STDOUT (join ' ', @_ ) . "\n" if $opt_debug;
  73. } # }}}
  74.  
  75. sub Inform($) { # {{{
  76.   print STDOUT (join ' ', @_) . "\n";
  77. } # }}}
  78.  
  79. sub Warn($) { # {{{
  80.   print STDERR (join ' ', @_) . "\n" if $opt_verbose;
  81. } # }}}
  82.  
  83. sub Error($) { # {{{
  84.   print STDERR (join ' ', @_) . "\n";
  85.   $exitval = 1;
  86. } # }}}
  87.  
  88. # non-fatal error
  89. sub ErrorNF($) { # {{{
  90.   print STDERR (join ' ', @_) . "\n";
  91. } # }}}
  92.  
  93. { # IgnoreSignals, RestoreSignals # {{{
  94.   
  95. our %sigactions = ('ignore_cnt' => 0);
  96.  
  97. sub _IgnoreRestoreSignals($) { # {{{
  98.   my $mode      = shift;
  99.  
  100.   my $ign_cnt   = undef;
  101.  
  102.  
  103.   if ($mode eq "ignore") {
  104.     $ign_cnt = $sigactions{'ignore_cnt'}++;
  105.   } elsif ($mode eq "restore") {
  106.     $ign_cnt = --$sigactions{'ignore_cnt'};
  107.   } else {  
  108.      croak "Invalid argument of IgnoreRestoreSignals: $mode";
  109.   }       
  110.   
  111.   croak "Invalid ign_cnt (" . $ign_cnt . ") in IgnoreRestoreSignals(" . $mode . ")"
  112.     if $ign_cnt < 0;
  113.  
  114.   return unless $ign_cnt == 0;
  115.  
  116.   Debug(ucfirst $mode . " signals");
  117.  
  118.   foreach my $sig ('INT', 'QUIT', 'HUP', 'TSTP', 'TERM') {
  119.     if ($mode eq "ignore") {
  120.       $sigactions{$sig} = $SIG{$sig} if defined $SIG{$sig};
  121.       $SIG{$sig} = "IGNORE";
  122.     } elsif ($mode eq "restore") {
  123.       $SIG{$sig} = defined $sigactions{$sig} ? $sigactions{$sig} : "DEFAULT";
  124.     } else {
  125.        croak "Invalid argument of IgnoreRestoreSignals: $mode";
  126.     }       
  127.   }
  128. } # }}}
  129.  
  130. sub IgnoreSignals() {
  131.   return _IgnoreRestoreSignals("ignore");
  132. }
  133.  
  134.  
  135. sub RestoreSignals() {
  136.   return _IgnoreRestoreSignals("restore");
  137. }
  138. } # }}}
  139.  
  140.  
  141.  
  142. sub ReadMap($$;$) { # {{{
  143.   my $file    = shift;
  144.   my $map     = shift;
  145.   my $defval  = shift;
  146.   $defval     = "" unless $defval;
  147.   open (MAP, "<", $file) or croak "Cannot open `$file' for reading: $!";
  148.   while(<MAP>) {
  149.           chomp;
  150.           next if /^\s*$/;
  151.           next if /^#/;
  152.           my ($lv,$rv) = split(/\s*:\s*/, $_, 2);
  153.           $map->{lc($lv)} = $rv ? $rv : $defval;
  154.   }
  155.   close(MAP);
  156. } # }}}
  157.  
  158.  
  159.  
  160. 1;
  161.